CD ROM Paradise Collection 4/CD ROM Paradise Collection 4 1995 Nov.iso/misc/makemsgs.zip/MAKEMSGS.BAS

BASIC Source File | 1994-12-26 | 6KB | 182 lines

'
' Copyright (c) 1994, John David Rohner.  All rights reserved.
'
' THIS SOFTWARE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED
' WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
' MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
' See the documentation for additional information.
'
'
' $INCLUDE: 'JDRBBS.INC'
'

CLEAR,,4096                                    'Stack size (see FRE(-2)).

  '
  ' What to give to all areas as default.
  '
  MsgArea.PostSL = 0
  MsgArea.ReadSL = 0
  MsgArea.ScanSL = 0
  MsgArea.StartTime = 0
  MsgArea.EndTime = 0
  MsgArea.BufferSize = 0
  MsgArea.NextNumber = 1
  MsgArea.SubType = 0
  CALL BitSet(MsgArea.SubType,3)          'Net area.
  CALL BitSet(MsgArea.SubType,9)          'EchoMail area.
  MsgArea.MsgOp = "SYSTEM OPERATOR"       'File Manip's or kill PATHS.DAT can
                                          'be used to easy change Msg-Op's.

  REDIM Chars$(255)
  FOR K = 0 TO 255
    Chars$(K) = CHR$(K)
  NEXT
  C1310$ = Chars$(13) + Chars$(10)
  Null$ = ""
  K$ = UCASE$(RTRIM$(LTRIM$(Command$)))
  K7 = (RIGHT$(K$,5) = "/TAGS")
  IF K7 THEN K$ = RTRIM$(LEFT$(K$,LEN(K$) - 5))
  K = FindF(K$,FFile)
  IF K = 0 _
     THEN CALL Ansi("1File not found.  Use MakeMsgs <pathname> [/tags]" + C1310$ + C1310$) : _
          END
  K0$ = Chars$(65 + DrCurrent) + ":\"

  '
  ' Add the new areas to Message Area definitions.
  '
  CALL Ansi("Adding areas...")
  K = FileOpen(K$,128 + 64 + 2)
  K0 = FileOpen(K0$ + "BBS\GLOBAL\SYSTEM\MSGBASES.DAT",128 + 64 + 2)
  K2 = FileOpen(K0$ + "BBS\GLOBAL\SYSTEM\ECHOS.DAT",128 + 64 + 2)
  K9 = FileLof&(K0,108)
  K8 = K9
  K& = 0
  DO
    MsgArea.Title = FileGetLine$(K,K&)
    IF RTRIM$(MsgArea.Title) <> Null$ _
       THEN K9 = K9 + 1 : _
            CALL FilePutRec(K0,K9,108,MsgArea) : _
            K1 = FileOpen(K0$ + "BBS\GLOBAL\INDEXES\MSGS_" + _
                          RIGHT$(STR$(1000 + K9),3) + ".IDX",128 + 64 + 2) : _
            CALL FileClose(K1) : _
            IF K7 THEN CALL FilePutSEnd(K2,MKI$(K9) + LEFT$(MsgArea.Title,30))
  LOOP UNTIL K& = -1
  CALL FileClose(K2)
  CALL FileClose(K0)
  CALL FileClose(K)

  '
  ' Add Last-Read and Messages Waiting fields for the new Message Areas.
  '
  K5 = FileOpen(K0$ + "BBS\GLOBAL\SYSTEM\USERMSGS",128 + 64 + 2)
  K6 = FileOpen("TEMPFILE.TMP",128 + 64 + 2)
  UserMsgInfo$ = STRING$(K8 * 5,0)

  K9 = K9 - K8
  CALL Ansi("Updating user Last-Read's for" + STR$(K9) + " areas...")
  K2$ = UserMsgInfo$
  K2 = LEN(UserMsgInfo$)
  K& = FileLof&(K5,1)
  K0& = - K2
  FOR K3 = 0 TO FileLof&(K5,K2) - 1
    K0& = K0& + K2
    CALL FileGetSLoc(K5,K0&,K2$)
    K3$ = LEFT$(K2$,K8 * 4) + STRING$(K9 * 4,0) + _
          MID$(K2$,K8 * 4 + 1) + STRING$(K9,0)
    CALL FilePutSEnd(K6,K3$)
  NEXT

'for when put into jdrbbs.exe
'  UserMsgInfo$ = K3$
'  CALL FileGetSLoc(K6,1& * (BiSearch(5,0,User.UserName) - 1) * LEN(K3$),UserMsgInfo$)

  CALL FileClose(K6)
  CALL FileClose(K5)
  CALL KillFile(K0$ + "BBS\GLOBAL\SYSTEM\USERMSGS")
  NAME "TEMPFILE.TMP" AS K0$ + "BBS\GLOBAL\SYSTEM\USERMSGS"
  CALL Ansi("Done." + C1310$)

END






        '* * * * * *
        ' This routine retrieves the next line of 'sequential' text
        ' from an already opened file.
        '
        ' p   file handle to read from.
        '     If < 0 then we use a 512 buffer instead of a 128 byte
        '     buffer.  (512 is the maximum BLKS file line allowed).
        '
        ' p&  location to start reading from.  p& is increased by the
        '     size of the returned string + 2.  -1 is returned at EOF.
        '
        ' If the retrieved 128 byte buffer has no CR/LF, then returns
        ' with all 128 bytes read.
        '
        ' A line with only a CR/LF on it is returned as a null.
        '
        ' The CR/LF is not included in the returned text.
        '
        ' At EOF, returned text may or may not contain text, but p&
        ' will be -1.
        '
        ' The last line read may or may not contain data (assume it
        ' does).
        '
        ' If ever looking to improve this routine, the following tests
        ' must be done: blank line handling, no CR on line handling, and
        ' only CR on line (or LF).
        '
        ' Date last checked for perfection: Sep 10 1992
        '
FUNCTION FileGetLine$ (p,p&)

  IF p > 0 THEN K0 = 128 _
           ELSE p = - p : _
                K0 = 512
  k& = FileLof&(p,1) - 2
  IF p& >= K& OR p& < 0 THEN FileGetLine$ = Null$ : _
                             p& = -1 : _
                             EXIT FUNCTION
  K$ = SPACE$(K0)
  k = 1
  DO
    IF k = 0 THEN K$ = K$ + K$    'we stop before it gets to 8192.
    CALL FileGetSLoc(p,p&,k$)
    k = StrSrch1(k$,13)
    WHILE K > 0 AND AscMid(K$,k + 1) <> 10
      K = StrSrch2(K,K$,13)
    WEND
    IF K = 0 AND p& + LEN(K$) > K& THEN K = StrSrch1(K$,0)
  LOOP UNTIL k <> 0 OR LEN(K$) >= 4096 OR p& + LEN(K$) > K&
  IF k > 0 THEN k$ = LEFT$(k$,k - 1) _
           ELSE k = LEN(K$)
  p& = p& + k + 1
  IF p& >= k& THEN p& = -1
  FileGetLine$ = k$

END FUNCTION
        '
        '* * * *






'
' to compile: BC MAKEMSGS.BAS /O/S/FS/G2;
' to link   : LINK /EXEPACK /PACKCODE MAKEMSGS,,,ASSEMBLY\JDRBBS,,
' requires  : BC.EXE, LINK.EXE, BCL70EFR.LIB, BRT70EFR.LIB, and JDRBBS.LIB
'             (Basic PDS 7.0+, and Juggernaut's assembly library)
'